﻿Public NotInheritable Class BetterEnumerable
    Private Sub New()
    End Sub
    Public Shared Function SteppedRange(fromInclusive As Integer, toExclusive As Integer, [step] As Integer) As IEnumerable(Of Integer)
        Dim i = fromInclusive
        While i < toExclusive
            Return New Integer() {i}
            i += [step]
        End While
    End Function
End Class
Class JaggedComparer
    Implements IComparer
    Public Function Compare(ByVal x As Object, ByVal y As Object) _
    As Integer Implements IComparer.Compare
        ' x and y are arrays of integers
        ' sort on the 2nd item in each array
        Dim a1() As Integer = DirectCast(x, Integer())
        Dim a2() As Integer = DirectCast(y, Integer())
        Return a1(1).CompareTo(a2(1))
    End Function
End Class

Public Class clsRegretCalc
    Private bDocument As Boolean = True
    Public Enum eJustifyDirection
        Left
        Right
    End Enum
    Public Enum ePrioRule
        SAZ
        SEZ
        FAZ
        FEZ
        DSEZ
    End Enum
    Private Function DePlanResource(ByVal planedAt As Int32, ByVal resource() As Int32,
                                ByVal dur As Int32, ByVal tasknr As Int32,
                                ByRef actMaxResource()() As Int32,
                                ByRef actPeakResource()() As Int32,
                                ByRef oDiagramm()()() As Int32, justify As eJustifyDirection) As Boolean
        Try
            Dim k As Int32
            If dur = 0 Then
                Return False
            End If
            Dim startTime As Int32 = planedAt
            Dim endTime As Int32 = planedAt + dur - 1
            Dim anzRes As Int32 = resource.Length - 1
            For k = 0 To anzRes
                Dim iRes As Int32 = resource(k)
                If iRes > 0 Then
                    Dim t As Int32
                    For t = startTime To endTime
                        actPeakResource(k)(t) -= iRes
                    Next
                End If
            Next
            Return True
        Catch ex As Exception
            Throw
        End Try
    End Function
    Private Function PlanResource(ByVal planedAt As Int32, ByVal resource() As Int32,
                                 ByVal dur As Int32, ByVal tasknr As Int32,
                                 ByRef actMaxResource()() As Int32,
                                 ByRef actPeakResource()() As Int32,
                                 ByRef oDiagramm()()() As Int32, justify As eJustifyDirection) As Boolean
        Try
            Dim k As Int32
            If dur = 0 Then
                Return False
            End If
            Dim startTime As Int32 = planedAt
            Dim endTime As Int32 = planedAt + dur - 1
            Dim anzRes As Int32 = resource.Length - 1
            For k = 0 To anzRes
                Dim iRes As Int32 = resource(k)
                If iRes > 0 Then 
                    Dim t As Int32
                    For t = startTime To endTime
                        If document Then
                            For d As Int32 = actPeakResource(k)(t) To actPeakResource(k)(t) + resource(k) - 1
                                oDiagramm(k)(d)(t) = tasknr
                            Next
                        End If
                        actPeakResource(k)(t) += iRes
                    Next
                End If
            Next
            Return True
        Catch ex As Exception
            Throw
        End Try
    End Function
    Private Function PossibleResourceContraintCalc(ByVal justify As eJustifyDirection, ByVal resource() As Int32,
                                           ByVal sez As Int32, ByVal dur As Int32, ByVal tasknr As Int32, ByVal maxres() As Int32,
                                           ByVal actMaxResource()() As Int32, ByVal actPeakResource()() As Int32,
                                            ByRef oDiagramm()()() As Int32) As Int32
        Try
            Dim shifter As Int32 = 0
            Dim startTime As Int32 = 0
            Dim endTime As Int32 = 0
            Dim theoretisch_eingeplant As Boolean = False
            Dim anzRes As Int32 = resource.Length - 1
            Dim steper As Int32 = 1
            Do While Not theoretisch_eingeplant
                'place for planning
                Select Case justify
                    Case eJustifyDirection.Left
                        'sez = faz at left js
                        'endtime = START
                        endTime = sez + shifter
                        startTime = endTime + dur
                    Case eJustifyDirection.Right
                        endTime = sez - shifter
                        startTime = endTime - dur
                        steper = -1
                End Select
                theoretisch_eingeplant = True
                For k = 0 To anzRes
                    Dim iMaxRes As Int32 = maxres(k)
                    Dim iRes As Int32 = resource(k)
                    If iRes > 0 Then
                        Dim peak() As Int32 = actPeakResource(k)
                        Dim t As Int32
                        t = endTime - If(justify = eJustifyDirection.Right, 1, 0)
                        Dim lexit As Int32 = startTime
                        If justify = eJustifyDirection.Right Then
                            lexit = startTime - 1
                        End If
                        Do Until t = lexit
                            If iMaxRes - peak(t) < iRes Then
                                theoretisch_eingeplant = False
                                Exit For
                            End If
                            t += 1 * steper
                        Loop
                    End If
                Next
                If Not theoretisch_eingeplant Then
                    shifter += 1
                End If
            Loop
            Return endTime
        Catch ex As Exception
            Throw
        End Try
    End Function
    Private Function Justify_vgl(ByVal ResPossibleSez As Int32, ByVal maxSez As Int32, ByVal justify As eJustifyDirection) As Boolean
        Try
            If justify = eJustifyDirection.Left Then
                Return ResPossibleSez < maxSez
            Else
                Return ResPossibleSez > maxSez
            End If
        Catch ex As Exception
            Throw
        End Try
    End Function
    Private Function Compare1(ByVal a As KeyValuePair(Of Int32, Int32), ByVal b As KeyValuePair(Of Int32, Int32)) As Int32
        Try
            Return a.Key.CompareTo(b.Key)
        Catch ex As Exception
            Throw
        End Try
    End Function
    Private Function Compare2(ByVal a As KeyValuePair(Of Int32, Int32), ByVal b As KeyValuePair(Of Int32, Int32)) As Int32
        Try
            Return b.Key.CompareTo(a.Key)
        Catch ex As Exception
            Throw
        End Try
    End Function
    Private Function Compare3(ByVal a As KeyValuePair(Of Int32, Int32), ByVal b As KeyValuePair(Of Int32, Int32)) As Int32
        Try
            Return b.Value.CompareTo(a.Value)
        Catch ex As Exception
            Throw
        End Try
    End Function
    Public Function Justify_Valls_byEx_1(ByRef proj As clsProject, ByVal justify As eJustifyDirection, ByRef diagrams As Dictionary(Of String, Int32()()),
                                  ByRef res_hash As Dictionary(Of Int32, Int32())) As HashSet(Of Int32)
        Try
            '   Dim al As New HashSet(Of Int32)
            Dim untilCount As Int32 = proj.TasksA.Count - 1
            Dim scheduleInfos As New clsScheduleInfos(proj)
            diagrams = New Dictionary(Of String, Int32()())
            scheduleInfos.Init(proj, diagrams, True)
            Dim order As New List(Of KeyValuePair(Of Int32, Int32))
            Dim i As Int32 = 0
            For Each task As clsTask In proj.TasksA
                'tempL.Add(task.PlanedAt, task.Key)
                If i > 0 Then
                    order.Add(New KeyValuePair(Of Int32, Int32)(task.PlanedAt + If(justify = eJustifyDirection.Right, task.Duration, 0), task.Key))
                End If
                i += 1
            Next
            Dim result
            If justify = eJustifyDirection.Right Then
                result = From o In order Order By o.Key Descending, o.Value Descending Select o.Value
                ' Order By .Sort(AddressOf Compare2)
            Else
                result = From o In order Order By o.Key Ascending, o.Value Ascending Select o.Value
                'Order By .Sort(AddressOf Compare1)
            End If

            'Dim 

            ' For Each t As KeyValuePair(Of Int32, Int32) In order
            For Each t In result
                Dim nr As Int32 = t
                Dim task As clsTask = proj.TasksA(nr)
                Dim resource() As Int32 = res_hash(task.Key)
                Dim duration As Int32 = task.Duration
                Dim sez As Int32 = 1000
                Select Case justify
                    Case eJustifyDirection.Left
                        sez = 0
                        For Each pre As Int32 In task.Pre
                            If pre > 0 Then
                                sez = Math.Max(sez, proj.TasksA(pre).PlanedAt + proj.TasksA(pre).Duration)
                            End If
                        Next
                    Case eJustifyDirection.Right
                        For Each post As Int32 In task.Post
                            If post > 0 Then
                                sez = Math.Min(sez, proj.TasksA(post).PlanedAt)
                            End If
                        Next
                        If sez = 1000 Then 'letzter
                            sez = task.PlanedAt
                        End If
                End Select
                DePlanResource(task.PlanedAt, resource, duration, nr, scheduleInfos.actMaxResource,
                                 scheduleInfos.actPeakResource, scheduleInfos.odiagram, justify)
                Dim ResPossibleSez As Int32 = PossibleResourceContraintCalc(justify, resource, sez, duration, nr, scheduleInfos.maxres,
                                                                            scheduleInfos.actMaxResource, scheduleInfos.actPeakResource, scheduleInfos.odiagram)
                proj.TasksA(nr).PlanedAt = ResPossibleSez - If(justify = eJustifyDirection.Right, duration, 0)
                PlanResource(proj.TasksA(nr).PlanedAt, resource, duration, nr, scheduleInfos.actMaxResource,
                                 scheduleInfos.actPeakResource, scheduleInfos.odiagram, justify)
            Next

            If justify = eJustifyDirection.Right Then
                ' Dim a As Int32
                'proj.ActivtyList = New HashSet(Of Int32)
                'For a = untilCount - 1 To 0 Step -1
                '    proj.ActivtyList.Add(al.ElementAt(a))
                'Next
                'al = proj.ActivtyList
                proj.TasksA.First.PlanedAt = proj.TasksA(1).PlanedAt
                Dim mover As Int32 = proj.TasksA.First.PlanedAt
                Dim last As Int32 = proj.TasksA.Last.PlanedAt
                If mover > 0 Then
                    For b = 0 To untilCount
                        Dim task As clsTask = proj.TasksA(b)
                        task.PlanedAt -= mover
                    Next
                    Dim k As Int32
                    Dim rescount As Int32 = proj.RenewableResources.Count - 1
                    For k = 0 To rescount
                        Array.Copy(scheduleInfos.actPeakResource(k), mover, scheduleInfos.actPeakResource(k), 0, last)
                    Next
                End If

            Else
                ' proj.ActivtyList = al
            End If
            proj.Fitness = proj.TasksA.Last.PlanedAt
            proj.PeakResource = scheduleInfos.actPeakResource

            proj.ActivtyList = GetAL(proj)

            If check Then
                Dim valid As Boolean = SuccessorValidation(proj)
                Dim resvalid As Boolean = ResourceValidation(proj)

                If Not (valid And resvalid) Then
                    Debug.Print("Invalid")
                End If
            End If
            Return proj.ActivtyList
        Catch ex As Exception
            Throw
        End Try
    End Function

    Public Function Justify_Valls_byEx(ByRef proj As clsProject, ByVal justify As eJustifyDirection, ByRef diagrams As Dictionary(Of String, Int32()()),
                                 ByRef res_hash As Dictionary(Of Int32, Int32())) As HashSet(Of Int32)
        Try
            '   Dim al As New HashSet(Of Int32)
            Dim untilCount As Int32 = proj.TasksA.Count - 1
            Dim scheduleInfos As New clsScheduleInfos(proj)
            diagrams = New Dictionary(Of String, Int32()())
            scheduleInfos.Init(proj, diagrams, False)
            Dim order As New List(Of KeyValuePair(Of Int32, Int32))
            Dim i As Int32 = 0
            For Each task As clsTask In proj.TasksA
                'tempL.Add(task.PlanedAt, task.Key)
                If i > 0 Then
                    order.Add(New KeyValuePair(Of Int32, Int32)(task.PlanedAt + If(justify = eJustifyDirection.Right, task.Duration, 0), task.Key))
                End If
                i += 1
            Next
            Dim result
            If justify = eJustifyDirection.Right Then
                result = From o In order Order By o.Key Descending, o.Value Descending Select o.Value
                ' Order By .Sort(AddressOf Compare2)
            Else
                result = From o In order Order By o.Key Ascending, o.Value Ascending Select o.Value
                'Order By .Sort(AddressOf Compare1)
            End If

            'Dim 

            ' For Each t As KeyValuePair(Of Int32, Int32) In order
            For Each t In result
                Dim nr As Int32 = t
                Dim task As clsTask = proj.TasksA(nr)
                Dim resource() As Int32 = res_hash(task.Key)
                Dim duration As Int32 = task.Duration
                Dim sez As Int32 = 1000
                Select Case justify
                    Case eJustifyDirection.Left
                        sez = 0
                        For Each pre As Int32 In task.Pre
                            If pre > 0 Then
                                sez = Math.Max(sez, proj.TasksA(pre).PlanedAt + proj.TasksA(pre).Duration)
                            End If
                        Next
                    Case eJustifyDirection.Right
                        For Each post As Int32 In task.Post
                            If post > 0 Then
                                sez = Math.Min(sez, proj.TasksA(post).PlanedAt)
                            End If
                        Next
                        If sez = 1000 Then 'letzter
                            sez = task.PlanedAt
                        End If
                End Select
                Dim ResPossibleSez As Int32 = PossibleResourceContraintCalc(justify, resource, sez, duration, nr, scheduleInfos.maxres,
                                                                            scheduleInfos.actMaxResource, scheduleInfos.actPeakResource, scheduleInfos.odiagram)
                proj.TasksA(nr).PlanedAt = ResPossibleSez - If(justify = eJustifyDirection.Right, duration, 0)
                PlanResource(proj.TasksA(nr).PlanedAt, resource, duration, nr, scheduleInfos.actMaxResource,
                                 scheduleInfos.actPeakResource, scheduleInfos.odiagram, justify)


            Next
            If justify = eJustifyDirection.Right Then
                proj.TasksA.First.PlanedAt = proj.TasksA(1).PlanedAt
                Dim mover As Int32 = proj.TasksA.First.PlanedAt
                Dim last As Int32 = proj.TasksA.Last.PlanedAt
                If mover > 0 Then
                    For b = 0 To untilCount
                        Dim task As clsTask = proj.TasksA(b)
                        task.PlanedAt -= mover
                    Next
                    Dim k As Int32
                    Dim rescount As Int32 = proj.RenewableResources.Count - 1
                    For k = 0 To rescount
                        Array.Copy(scheduleInfos.actPeakResource(k), mover, scheduleInfos.actPeakResource(k), 0, last)
                    Next
                End If
            End If
            proj.Fitness = proj.TasksA.Last.PlanedAt
            proj.PeakResource = scheduleInfos.actPeakResource
            proj.ActivtyList = GetAL(proj)

            If check Then
                Dim valid As Boolean = SuccessorValidation(proj)
                Dim resvalid As Boolean = ResourceValidation(proj)

                If Not (valid And resvalid) Then
                    Debug.Print("Invalid")
                End If
            End If
            Return proj.ActivtyList
        Catch ex As Exception
            Throw
        End Try
    End Function
    Public Function Justify_Valls(ByRef proj As clsProject, ByVal justify As eJustifyDirection,
                                  ByRef diagrams As Dictionary(Of String, Int32()()),
                                  ByRef res_hash As Dictionary(Of Int32, Int32())) As HashSet(Of Int32)
        Try
            'new activity list

            '    clsDiagrammCreator.WriteFile("C:\makespan.htm", proj.Diagramm, CType(proj, clsProject))

            Dim al As New HashSet(Of Int32)
            Dim untilCount As Int32 = proj.TasksA.Count - 1
            Dim possiblePrePostTasks As New HashSet(Of Int32)
            Dim dic As New HashSet(Of KeyValuePair(Of Int32, Int32))
            Dim scheduleInfos As New clsScheduleInfos(proj)
            diagrams = New Dictionary(Of String, Int32()())
            scheduleInfos.Init(proj, diagrams)
            Dim al_begin As Int32 = If(justify = eJustifyDirection.Right, untilCount, 1)
            Dim al_end As Int32 = If(justify = eJustifyDirection.Right, 1, untilCount)
            'Dim al_step As Int32 = If(justify = eJustifyDirection.Right, -1, 1)
            'determine first element for justification (supersink)
            Dim first As clsTask = If(justify = eJustifyDirection.Right, proj.TasksA.Last, proj.TasksA.First)
            Dim eligbleTasks As New HashSet(Of Int32)

            Dim maxSpan As Int32 = proj.Fitness 'right justified upper bound
            al.Add(first.Key) 'super sink/source added first
            possiblePrePostTasks.Add(first.Key)

            Dim ovPuffer As Int32 = 0
            If justify = eJustifyDirection.Right Then
                ovPuffer = 50
                proj.TasksA(1).PlanedAt = proj.TasksA.First.PlanedAt
                For i = 0 To proj.TasksA.Count - 1
                    Dim task As clsTask = proj.TasksA(i)
                    task.PlanedAt += ovPuffer
                Next
            End If

            Do Until al.Count = untilCount

                For Each possible As Int32 In possiblePrePostTasks
                    Dim possiblePrePostTask As clsTask = proj.TasksA(possible)
                    If justify = eJustifyDirection.Right Then
                        For Each pre As Int32 In possiblePrePostTask.Pre
                            If Not eligbleTasks.Contains(pre) Then
                                If Not al.Contains(pre) Then
                                    Dim bFinished As Boolean = True
                                    For Each p As Int32 In proj.TasksA(pre).Post
                                        If Not al.Contains(p) Then
                                            bFinished = False
                                            Exit For
                                        End If
                                    Next
                                    If bFinished Then eligbleTasks.Add(pre)
                                End If
                            End If
                        Next
                    Else
                        For Each post As Int32 In possiblePrePostTask.Post
                            If Not eligbleTasks.Contains(post) Then
                                If Not al.Contains(post) Then
                                    Dim bFinished As Boolean = True
                                    For Each p As Int32 In proj.TasksA(post).Pre
                                        If Not al.Contains(p) Then
                                            bFinished = False
                                            Exit For
                                        End If
                                    Next
                                    If bFinished Then eligbleTasks.Add(post)
                                End If
                            End If
                        Next
                    End If
                Next

                Dim maxSez As Int32 = 0
                If justify = eJustifyDirection.Left Then
                    maxSez = 1000
                End If
                Dim toPlan As Int32 = 0
                Dim toPlanDur As Int32 = 0
                Dim toPlanRes() As Int32
                If eligbleTasks.Count = 1 AndAlso eligbleTasks(0) = al_end Then
                    al.Add(eligbleTasks(0))
                    If justify = eJustifyDirection.Left Then
                        Dim makespan As Int32 = 0
                        For Each p As Int32 In proj.TasksA(eligbleTasks(0)).Pre
                            makespan = Math.Max(makespan, proj.TasksA(p).PlanedAt + proj.TasksA(p).Duration)
                        Next
                        proj.TasksA(eligbleTasks(0)).PlanedAt = makespan
                    End If
                    Exit Do
                End If

                For Each eligble As Int32 In eligbleTasks
                    Dim task As clsTask = proj.TasksA(eligble)
                    Dim resource() As Int32 = res_hash(task.Key)
                    Dim duration As Int32 = task.Duration
                    Dim sez As Int32 = 1000
                    Select Case justify
                        Case eJustifyDirection.Left
                            sez = 0
                            For Each pre As Int32 In task.Pre
                                sez = Math.Max(sez, proj.TasksA(pre).PlanedAt + proj.TasksA(pre).Duration)
                            Next
                        Case eJustifyDirection.Right
                            For Each post As Int32 In task.Post
                                sez = Math.Min(sez, proj.TasksA(post).PlanedAt)
                            Next
                    End Select

                    Dim ResPossibleSez As Int32 = PossibleResourceContraintCalc(justify, resource, sez, duration, task.Key, scheduleInfos.maxres,
                                                                                scheduleInfos.actMaxResource, scheduleInfos.actPeakResource, scheduleInfos.odiagram)
                    If Justify_vgl(ResPossibleSez, maxSez, justify) Then
                        maxSez = ResPossibleSez
                        toPlan = task.Key
                        toPlanDur = task.Duration
                        toPlanRes = resource
                    Else
                        If ResPossibleSez = maxSez Then
                            Dim actScheduledEnd = task.PlanedAt + If(justify = eJustifyDirection.Right, task.Duration, 0)
                            Dim bestScheduledEnd = proj.TasksA(toPlan).PlanedAt + If(justify = eJustifyDirection.Right, proj.TasksA(toPlan).Duration, 0)
                            If Justify_vgl(actScheduledEnd, bestScheduledEnd, justify) Then
                                toPlan = task.Key
                                toPlanDur = task.Duration
                                toPlanRes = resource
                            Else
                                If actScheduledEnd = bestScheduledEnd Then
                                    Dim val As Single = 0
                                    If randomType = 1 Then
                                        If randInit Then Randomize()
                                        val = Rnd()
                                    Else
                                        If randInit Then RandNum = New Random
                                        val = RandNum.NextDouble
                                    End If

                                    If val > 0.5 Then
                                        toPlan = task.Key
                                        toPlanDur = task.Duration
                                        toPlanRes = resource
                                    End If
                                End If
                            End If
                        End If
                    End If
                Next

                If toPlan > 1 Then
                    PlanResource(maxSez, toPlanRes, toPlanDur, toPlan, scheduleInfos.actMaxResource,
                                 scheduleInfos.actPeakResource, scheduleInfos.odiagram, justify)
                    al.Add(toPlan)
                    proj.TasksA(toPlan).PlanedAt = maxSez - If(justify = eJustifyDirection.Right, toPlanDur, 0)
                    eligbleTasks.Remove(toPlan)
                    Dim templist As HashSet(Of Int32) = New HashSet(Of Int32)(possiblePrePostTasks)
                    For Each possible As Int32 In templist
                        Dim allPlaned As Boolean = True
                        Dim Taskiterator As HashSet(Of Int32) = If(justify = eJustifyDirection.Left, proj.TasksA(possible).Post, proj.TasksA(possible).Pre)
                        For Each p As Int32 In Taskiterator
                            If Not al.Contains(p) Then
                                allPlaned = False
                                Exit For
                            End If
                        Next
                        If allPlaned Then
                            possiblePrePostTasks.Remove(possible)
                        End If
                    Next
                    possiblePrePostTasks.Add(toPlan)
                Else
                    Throw New Exception("nothing to plan")
                End If
            Loop




            proj.Diagramm = scheduleInfos.odiagram

            If justify = eJustifyDirection.Right Then
                Dim a As Int32
                proj.ActivtyList = New HashSet(Of Int32)
                For a = untilCount - 1 To 0 Step -1

                    proj.ActivtyList.Add(al.ElementAt(a))
                Next
                al = proj.ActivtyList
                Dim minMover As Int32 = 1000
                For Each p As Int32 In proj.TasksA.First.Post
                    minMover = Math.Min(minMover, proj.TasksA(p).PlanedAt)
                Next
                proj.TasksA.First.PlanedAt = minMover
                proj.TasksA(1).PlanedAt = proj.TasksA.First.PlanedAt
                Dim mover As Int32 = proj.TasksA.First.PlanedAt
                If mover > 0 Then
                    For b = 0 To proj.TasksA.Count - 1
                        Dim task As clsTask = proj.TasksA(b)
                        task.PlanedAt -= mover
                    Next
                End If
                proj.Fitness = proj.TasksA.Last.PlanedAt
                '  clsDiagrammCreator.WriteFile("C:\makespan_r.htm", proj.Diagramm, CType(proj, clsProject), mover + 1)
            Else
                proj.ActivtyList = al
                proj.Fitness = proj.TasksA.Last.PlanedAt
                ' clsDiagrammCreator.WriteFile("C:\makespan_l.htm", proj.Diagramm, CType(proj, clsProject))
            End If
            proj.PlanedTimes = PlanedToString(proj)

            If check Then
                Dim valid As Boolean = SuccessorValidation(proj)
                Dim resvalid As Boolean = ResourceValidation(proj)

                If Not (valid And resvalid) Then
                    Debug.Print("Invalid")
                End If
            End If

            Return al

            'For Each task As clsTask In proj.Tasks.Values
            '    dic.Add(New KeyValuePair(Of Int32, Int32)(task.Key, task.PlanedAt + If(justify = eJustifyDirection.Right, task.Duration, 0)))
            'Next
            'dic.Sort(AddressOf comp)

            'For Each pair As KeyValuePair(Of Int32, Int32) In dic
            '    al.Add(pair.Key)
            'Next
            'Return al
        Catch ex As Exception
            Throw
        End Try
    End Function

    Private Function comp(ByVal a As KeyValuePair(Of Int32, Int32), ByVal b As KeyValuePair(Of Int32, Int32)) As Int32
        Try
            Return a.Value.CompareTo(b.Value)
        Catch ex As Exception
            Throw
        End Try

    End Function
    Private Function compUp(ByVal a As KeyValuePair(Of Int32, Int32), ByVal b As KeyValuePair(Of Int32, Int32)) As Int32
        Try
            Return b.Value.CompareTo(a.Value)
        Catch ex As Exception
            Throw
        End Try
    End Function
    Public Function CalcRegretBiasedRandomSampling_Hartmann(ByRef projInfo As clsProject, ByVal alpha As Double, ByVal constE As Double, ByVal prioType As ePrioRule,
                                                            Optional ByVal order As HashSet(Of Int32) = Nothing, Optional ByVal bPlan As Boolean = False,
                                                            Optional ByVal res_hash As Dictionary(Of Int32, Int32()) = Nothing) As HashSet(Of Int32)
        Try
            Dim bPreferNull As Boolean = False
            Dim tempProject = projInfo
            If bPlan Then
                prioType = ePrioRule.SEZ
            End If
            Dim taskShortList As New HashSet(Of Int32)
            Dim beta As Single = 0
            Dim shortList As New HashSet(Of Int32) 'potentiel Pres
            shortList.Add(1) 'super source to shortlist
            taskShortList.Add(1)
            Dim scheduleInfos As New clsScheduleInfos(projInfo)
            Dim diagrams As New Dictionary(Of String, Int32()())
            Dim makespan As New clsMakeSpanWithRes
            Dim ms As Int32
            If bPlan Then
                scheduleInfos.Init(projInfo, diagrams)
            End If
            Do While taskShortList.Count < tempProject.TasksA.Count - 1
                If randomType = 1 Then
                    If randInit Then Randomize()
                End If

                Dim bTakeFromOrder As Boolean = False
                'neigbourhood search
                If Not order Is Nothing Then
                    beta = 1 - (20 / (projInfo.TasksA.Count - 1))
                    Dim vgl As Single = 0
                    If randomType = 1 Then
                        vgl = Rnd()
                    Else
                        If randInit Then RandNum = New Random
                        vgl = RandNum.NextDouble()
                    End If
                    If vgl < beta Then
                        bTakeFromOrder = True
                    End If
                End If
                Dim postCandidates As New HashSet(Of Int32)
                For Each itm As Int32 In shortList
                    Dim preCandidates As clsTask = tempProject.TasksA(itm)
                    For Each post As Int32 In preCandidates.Post
                        If Not postCandidates.Contains(post) And Not taskShortList.Contains(post) Then
                            Dim bPreFinished As Boolean = True
                            Dim candidate As clsTask = tempProject.TasksA(post)
                            Dim earliestStart As Int32 = 0
                            For Each p As Int32 In candidate.Pre
                                If Not taskShortList.Contains(p) Then
                                    bPreFinished = False
                                    Exit For
                                End If
                                'earliestStart = Math.Max(earliestStart, tempProject.TasksA(p).PlanedAt + tempProject.TasksA(p).Duration)
                            Next
                            If bPreFinished Then
                                If bPlan Then
                                    'candidate.FAZ = earliestStart
                                    '    candidate.FEZ = earliestStart + candidate.Duration
                                    '    candidate.SEZ = candidate.FEZ + candidate.Puffer
                                End If
                                postCandidates.Add(post)
                            End If
                        End If
                    Next
                Next
                Dim target As clsTask = Nothing
                If bTakeFromOrder Then
                    Dim bexit As Boolean = False
                    For Each itm As Int32 In order
                        If bPreferNull Then
                            For Each cand As Int32 In postCandidates
                                Dim x As clsTask = projInfo.TasksA(cand)
                                If x.Puffer = 0 Then
                                    target = x
                                    bexit = True
                                    Exit For
                                End If
                            Next
                        End If
                        If bexit Then
                            Exit For
                        End If
                        If postCandidates.Contains(itm) Then
                            target = projInfo.TasksA(itm)
                            order.Remove(itm)
                            bexit = True
                            Exit For
                        End If
                    Next
                Else
                    Dim PrioCompareValue As Int32 = If(rbrs_obj_min, 0, tempProject.MPMTime)
                    GetMinimumChildValue(postCandidates, tempProject, prioType, PrioCompareValue, rbrs_obj_min)
                    Dim RegretSum As Int32 = 0
                    Dim bNullPuffer As Boolean = False
                    Dim nullPufferTask As clsTask = Nothing
                    For Each potentialPost As Int32 In postCandidates
                        Dim task As clsTask = tempProject.TasksA(potentialPost)
                        If bPreferNull Then
                            If task.MPMPuffer = 0 Then
                                nullPufferTask = task
                                bNullPuffer = True
                                Exit For
                            End If
                        End If
                        task.RegretValue1 = CalcRegret1(task.PriorityValue, PrioCompareValue, rbrs_obj_min)
                        If order Is Nothing Then
                            '€=1
                            'task.RegretValue2 = CalcRegret2(task.RegretValue1, alpha, constE)

                            task.RegretValue2 = CalcRegret2(task.RegretValue1, alpha, PrioCompareValue)
                        Else
                            If reg2 Then
                                task.RegretValue2 = CalcRegret2(task.RegretValue1, alpha, PrioCompareValue)
                                'task.RegretValue2 = CalcRegret2(task.RegretValue1, alpha, 1)
                            Else
                                'task.RegretValue2 = task.Position
                                task.RegretValue2 = task.PriorityValue
                            End If
                        End If
                        RegretSum += task.RegretValue2
                    Next
                    If Not bNullPuffer Then
                        Dim xrnd As Single = 0
                        If randomType = 1 Then
                            xrnd = Rnd()
                        Else
                            If randInit Then RandNum = New Random
                            xrnd = RandNum.NextDouble()
                        End If

                        Dim probList As Double = 0
                        If postCandidates.Count > 1 And RegretSum > 0 Then
                            For Each potentialPost As Int32 In postCandidates
                                Dim task As clsTask = tempProject.TasksA(potentialPost)
                                task.SelectProbability = CalcSelectPropability(task.RegretValue2, RegretSum)
                                Dim lower As Double = probList
                                probList += task.SelectProbability
                                If lower <= xrnd And probList >= xrnd Then
                                    target = task
                                    Exit For
                                End If
                            Next
                        Else
                            target = tempProject.TasksA(postCandidates.First)
                        End If
                    Else
                        target = nullPufferTask
                    End If
                    End If
                shortList.Add(target.Key)
                taskShortList.Add(target.Key)
                If bPlan Then
                    Dim duration As Int32 = target.Duration
                    Dim resource() As Int32 = res_hash(target.Key)
                    Dim zeile(scheduleInfos.count) As Int32
                    Dim shifter As Int32 = 0
                    Dim faz As Int32 = target.FAZ
                    shifter = makespan.ResourceContraintCalc(projInfo, clsMakeSpanWithRes.eDirection.Left, resource, faz, duration, target.Key, scheduleInfos.maxres,
                                                             scheduleInfos.actMaxResource, scheduleInfos.actPeakResource,
                                                             Nothing, scheduleInfos.odiagram)
                    ms = Math.Max(ms, faz + shifter + duration)
                    target.PlanedAt = faz + shifter
                End If
                Dim templist As HashSet(Of Int32) = New HashSet(Of Int32)(shortList)
                For Each itm As Int32 In templist
                    Dim bAllDone As Boolean = True
                    Dim task As clsTask = tempProject.TasksA(itm)
                    For Each post As Int32 In task.Post
                        If Not taskShortList.Contains(post) Then
                            bAllDone = False
                            Exit For
                        End If
                    Next
                    If bAllDone Then
                        shortList.Remove(itm)
                    End If
                Next
            Loop
            If bPlan Then
                projInfo.PeakResource = scheduleInfos.actPeakResource
                projInfo.Diagramm = scheduleInfos.odiagram
                projInfo.Fitness = projInfo.TasksA.Last.PlanedAt
                If projInfo.Fitness <> ms Then
                    Throw New Exception("Error Calc Makespan Hartmann")
                End If
                If check Then
                    Dim valid As Boolean = SuccessorValidation(projInfo)
                    Dim resvalid As Boolean = ResourceValidation(projInfo)
                    If Not (valid And resvalid) Then
                        Debug.Print("Invalid")
                    End If
                End If
                taskShortList = GetAL(projInfo)
                projInfo.ActivtyList = taskShortList
            End If
            Return taskShortList
        Catch ex As Exception
            Throw
        End Try
    End Function

    Private Function KeyListToArray(ByVal ht As Hashtable) As Int32()
        Try
            Dim taskCount As Int32 = ht.Count - 1
            Dim keylist(taskCount) As Int32
            ht.Keys.CopyTo(keylist, 0)
            Array.Sort(keylist)
            Return keylist
        Catch ex As Exception
            Throw
        End Try
    End Function

    Private Function SetPrioValue(ByRef task As clsTask, ByVal prioType As ePrioRule) As Int32
        Try
            Dim temp As Int32
            Select Case prioType
                Case ePrioRule.FAZ
                    temp = task.MPMFAZ
                Case ePrioRule.FEZ
                    temp = task.MPMFEZ
                Case ePrioRule.SAZ
                    temp = task.MPMSAZ
                Case ePrioRule.SEZ
                    temp = task.MPMSEZ
                Case ePrioRule.DSEZ
                    temp = task.SEZ
            End Select
            task.PriorityValue = temp
            Return temp
        Catch ex As Exception
            Throw
        End Try
    End Function
    Private Sub GetMinimumChildValue(ByVal list As HashSet(Of Int32), ByVal projInfo As clsProject, ByVal prioType As ePrioRule, ByRef actCompareValue As Int32, ByVal objectiveMin As Boolean)
        Try
            For Each itm As Int32 In list
                Dim task As clsTask = projInfo.TasksA(itm)
                If objectiveMin Then
                    actCompareValue = Math.Max(SetPrioValue(task, prioType), actCompareValue)
                Else
                    actCompareValue = Math.Min(SetPrioValue(task, prioType), actCompareValue)
                End If

            Next
        Catch ex As Exception
            Throw
        End Try
    End Sub
    Private Sub GetMinimumChildValue(ByVal projInfo As clsProject, ByVal prioType As ePrioRule, ByRef actCompareValue As Int32)
        Try
            Throw New NotImplementedException("not used")
            'For Each task As clsTask In projInfo.TasksA
            '    If prioType = ePrioRule.SEZ Then
            '        actCompareValue = Math.Min(SetPrioValue(task, prioType), actCompareValue)
            '    Else
            '        actCompareValue = Math.Max(SetPrioValue(task, prioType), actCompareValue)
            '    End If
            'Next
        Catch ex As Exception
            Throw
        End Try
    End Sub

    Private Function CalcRegret1(ByVal prio As Int32, ByVal prioComp As Int32, ByVal obj_min As Boolean) As Int32
        Try
            If obj_min Then
                Return prioComp - prio
            Else
                Return Math.Abs(prio - prioComp)
            End If

        Catch ex As Exception
            Throw
        End Try
    End Function

    Private Function CalcRegret2(ByVal prio As Int32, ByVal alpha As Double, ByVal e As Double) As Int32
        Try
            Return Math.Pow(prio + e, alpha)
        Catch ex As Exception
            Throw
        End Try
    End Function
    Private Function CalcSelectPropability(ByVal prio As Int32, sumPrios As Int32) As Double
        Try
            Return prio / sumPrios
        Catch ex As Exception
            Throw
        End Try
    End Function

End Class
